Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue24/survive/MULTGRID.PAS

Pascal/Delphi Source File | 1997-05-19 | 11.7 KB | 420 lines

unit MultGrid;

{ Note:  When using the TDBMultiGrid component, if you repopulate the dataset while
  within a DisableControls/EnableControls block the selected rows will not be cleared.
  For example:

    with Query1 do
    begin
      DisableControls;
      try
        Close;
        Open; (*Presumably with new parameter settings *)
      finally
        EnableControls;
      end;
    end;

  Any rows that were selected prior to this routine will remain selected.  However,
  if you close the dataset outside of the DisableControls/EnableControls block, the
  selected rows are cleared:

    with Query1 do
    begin
      Close;
      DisableControls;
      try
        Open; (*Presumably with new parameter settings *)
      finally
        EnableControls;
      end;
    end;

}

interface

uses
  WinTypes, Classes, Controls, DB, DBGrids, Grids;

type
  TMultiGridSelectingEvent = procedure (Sender: TObject; var Selected: Boolean) of object;

  TDBMultiGrid = class(TDBGrid)
  private
    FSelectedList: TList;
  protected
    FAllowRedraw: Boolean;
    FAllowRedrawLevel: Integer;
    FAutoSelect: Boolean;
    FDataField: string;
    FDefaultDrawing: Boolean; { This mimicks the inherited DefaultDrawing property; see DrawCell }
    FOldStateChangeHandler: TNotifyEvent;
    FOldKeyDownHandler: TKeyEvent;
    FOldDblClickHandler: TNotifyEvent;

    FOnSelecting: TMultiGridSelectingEvent;
    FOnSelected: TNotifyEvent;
    procedure DoDblClick(Sender: TObject);
    procedure DoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure DoStateChange(Sender: TObject);
    function GetAnySelected: Boolean;
    function GetSelected: Boolean;
    procedure SetSelected(Value: Boolean);
    function GetDefaultDrawing: Boolean;
    procedure SetAllowRedraw(Value: Boolean);
    procedure SetDefaultDrawing(Value: Boolean);
    procedure Loaded; override;
    procedure SetAutoSelect(Value: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
    procedure DrawDataCell(const Rect: TRect; Field: TField; State: TGridDrawState); override;
    procedure GetSelectedValues(List: TList);
    procedure SelectAll(Switch: Boolean);
    procedure SetSelectedValues(List: TList);

    property AllowRedraw: Boolean read FAllowRedraw write SetAllowRedraw;
    property AnySelected: Boolean read GetAnySelected;
    property Selected: Boolean read GetSelected write SetSelected;
  published
    property AutoSelect: Boolean read FAutoSelect write SetAutoSelect default True;
    property DataField: string read FDataField write FDataField;
    property DefaultDrawing: Boolean read GetDefaultDrawing write SetDefaultDrawing default True;
    property OnClick;
    property OnSelected: TNotifyEvent read FOnSelected write FOnSelected;
    property OnSelecting: TMultiGridSelectingEvent read FOnSelecting write FOnSelecting;
  end;

  procedure Register;

implementation

uses
  WinProcs, Graphics, SysUtils, DbTables;

{ TDBMultiGrid }

constructor TDBMultiGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSelectedList := TList.Create;
  FDataField := '';
  FDefaultDrawing := True;
  FAllowRedraw := True;
  FAllowRedrawLevel := 0;
  FAutoSelect := True;  { default }
  Options := Options + [dgRowSelect];
end;

destructor TDBMultiGrid.Destroy;
begin
  FSelectedList.Free;
  inherited Destroy;
end;

procedure TDBMultiGrid.DoStateChange(Sender: TObject);
begin
  if DataSource <> nil then
    if DataSource.State = dsInactive then
      FSelectedList.Clear;

  if Assigned(FOldStateChangeHandler) then
    FOldStateChangeHandler(Sender);
end;

procedure TDBMultiGrid.DoDblClick(Sender: TObject);
begin
  if AutoSelect then
    Selected := not Selected;

  if Assigned(FOldDblClickHandler) then
    FOldDblClickHandler(Sender);
end;

procedure TDBMultiGrid.DoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if AutoSelect then
  begin
    if Key = VK_SPACE then
      Selected := not Selected;
  end;

  if Assigned(FOldKeyDownHandler) then
    FOldKeyDownHandler(Sender, Key, Shift);
end;

procedure TDBMultiGrid.Loaded;
begin
  inherited Loaded;
  FOldKeyDownHandler := OnKeyDown;
  OnKeyDown := DoKeyDown;
  FOldDblClickHandler := OnDblClick;
  OnDblClick := DoDblClick;

  if Datasource <> nil then
  begin
    FOldStateChangeHandler := DataSource.OnStateChange;
    DataSource.OnStateChange := DoStateChange;
  end;
end;

function TDBMultiGrid.GetAnySelected: Boolean;
begin
  Result := FSelectedList.Count <> 0;
end;

function TDBMultiGrid.GetSelected: Boolean;
begin
  Result := False;
  if DataSource <> nil then
    Result := FSelectedList.IndexOf(Pointer(DataSource.DataSet.FieldByName(FDataField).AsInteger)) <> -1;
end;

procedure TDBMultiGrid.SetSelected(Value: Boolean);
var
  Index: LongInt;
begin
  if DataSource <> nil then
  begin
    if DataSource.DataSet.FieldByName(FDataField).IsNull then Exit;
    Index := DataSource.DataSet.FieldByName(FDataField).AsInteger;

    if Value <> (FSelectedList.IndexOf(Pointer(Index)) <> -1) then
    begin
      if Assigned(FOnSelecting) then FOnSelecting(Self, Value);
      if Value <> (FSelectedList.IndexOf(Pointer(Index)) <> -1) then
      begin
        if Value then
          FSelectedList.Add(Pointer(Index))
        else
          FSelectedList.Delete(FSelectedList.IndexOf(Pointer(Index)));

        { Value could have been changed by FOnSelecting }
        if FAllowRedraw then Repaint;
        if Assigned(FOnSelected) then FOnSelected(Self);
      end;
    end;
  end;
end;

procedure TDBMultiGrid.SetAllowRedraw(Value: Boolean);
begin
  if Value then
  begin
    Dec(FAllowRedrawLevel);
    if FAllowRedrawLevel <= 0 then
    begin
      FAllowRedrawLevel := 0;
      Repaint;
      FAllowRedraw := True;
    end;
  end
  else
  begin
    Inc(FAllowRedrawLevel);
    FAllowRedraw := False;
  end;
end;

procedure TDBMultiGrid.SetAutoSelect(Value: Boolean);
begin
  if Value <> FAutoSelect then
    FAutoSelect := Value;
end;

function TDBMultiGrid.GetDefaultDrawing: Boolean;
begin
  Result := inherited DefaultDrawing;
end;

procedure TDBMultiGrid.SetDefaultDrawing(Value: Boolean);
begin
  FDefaultDrawing := Value;
  inherited DefaultDrawing := Value;
end;

procedure TDBMultiGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
{ This is a kludge.  The default drawing behavior of the TDBGrid is being changed by this
  descendant.  However, the routine where this is done, DefaultDrawDataCell, is not
  virtual, so we must override the DrawCell method (which is responsible for calling
  DefaultDrawDataCell).  We need to prevent DrawCell from calling DefaultDrawDataCell
  by forcing the inherited DefaultDrawing property to false.  But we must preserve the
  state of the DefaultDrawing property to allow user-defined cell drawing event handlers
  for this descendant. }
begin
  { Force DefaultDrawing to false to prevent the inherited TDBGrid's DefaultDrawDataCell
    from executing.  Our own default drawing will take place in the DrawDataCell method. }
  inherited DefaultDrawing := False;
  inherited DrawCell(ACol, ARow, ARect, AState);

  { Restore the state of the DefaultDrawing property }
  inherited DefaultDrawing := FDefaultDrawing;
end;

procedure TDBMultiGrid.DrawDataCell(const Rect: TRect; Field: TField;
  State: TGridDrawState);
var
  DrawFormat: Integer;
  FieldText: array[0..255] of Char;
  ARect: TRect;
  BackgroundColor: TColor;
  ForegroundColor: TColor;
begin
  if FDefaultDrawing then  { Do NOT query the inherited DefaultDrawing property }
  begin
    DrawFormat := DT_LEFT;
    FillChar(FieldText, SizeOf(FieldText), 0);

    { Capture field information; DisplayText provides cell formatting }
    if Field <> nil then
    begin
      StrPCopy(FieldText, Field.DisplayText);
      case Field.Alignment of
        taRightJustify: DrawFormat := DT_RIGHT;
        taCenter: DrawFormat := DT_CENTER;
      end;
    end;

    { Set highlight colors if row is selected }
    if (FDataField <> '') and Selected then
    begin
      BackgroundColor := clHighlight;
      ForegroundColor := clHighlightText;
    end
    else
    begin
      BackgroundColor := Color;
      ForegroundColor := Font.Color;
(*      if gdSelected in State then
      begin
        BackgroundColor := clWindow;
        ForegroundColor := clWindowText;
      end
      else
      begin
        BackgroundColor := Canvas.Brush.Color;
        ForegroundColor := Canvas.Font.Color;
      end;*)
    end;

    { Adjust the rectangle to draw in the same boundaries that TDBGrid draws }
    Move(Rect, ARect, SizeOf(Rect));
    Inc(ARect.Top, 2);
    case DrawFormat of
      DT_LEFT: Inc(ARect.Left, 2);
      DT_RIGHT: Dec(ARect.Right, 3);
      DT_CENTER: begin
        Inc(ARect.Left);
        Dec(ARect.Right);
      end;
    end;

    { Set and paint the cell background color }
    Canvas.Brush.Color := BackgroundColor;
    Canvas.FillRect(Rect);  { use the original rectangle }

    { Draw the text in the cell }
    Canvas.Font.Color := ForegroundColor;
    DrawText(Canvas.Handle, FieldText, -1, ARect, DrawFormat);

    { Draw a focused cell if needed }
    if (gdFocused in State) and not (dgRowSelect in Options) then
      Canvas.DrawFocusRect(Rect);
  end;

  inherited DrawDataCell(Rect, Field, State);
end;

procedure TDBMultiGrid.GetSelectedValues(List: TList);
{ Returns a list of the index values for all selected rows.  The TList returns does
  not contain pointers to objects, but the value of the pointers are in fact the
  index values of the selected rows (if typecast to LongInt). }

var
  BMark: TBookmark;
begin

  { Loop through the records.  Originally, the ForAll method of the Orpheus sparse
    array was used, but this produced a list of table in Drop_ID order, which is
    not necessarily the same as the display order. }

  AllowRedraw := False;
  with DataSource.DataSet do
  begin
    DisableControls;
    try
      BMark := GetBookmark;
      First;
      while not Eof do
      begin
        if Selected then
          List.Add(Pointer(FieldByName(FDataField).AsInteger));
        Next;
      end;
      GotoBookmark(BMark);
    finally
      EnableControls;
      FreeBookmark(BMark);
    end;
  end;
  AllowRedraw := True;
end;

procedure TDBMultiGrid.SetSelectedValues(List: TList);
{ Given a list of index values (LongInts in place of the object pointers), marks
  those rows as selected (any existing selected rows remain selected).}
var
  I: Integer;
  Value: Boolean;
begin
  AllowRedraw := False;
  for I := 0 to List.Count - 1 do
  begin
    Value := True;
    if Assigned(FOnSelecting) then FOnSelecting(Self, Value);
    if Value then FSelectedList.Add(List[I])
    else if FSelectedList.IndexOf(List[I]) <> -1 then
      FSelectedList.Delete(FSelectedList.IndexOf(List[I]));
    if Assigned(FOnSelected) then FOnSelected(Self);
  end;
  AllowRedraw := True;
end;

procedure TDBMultiGrid.SelectAll(Switch: Boolean);
var
  BMark: TBookmark;
begin

  { Loop through the records so the OnSelecting and OnSelected events fire }

  AllowRedraw := False;
  with DataSource.DataSet do
  begin
    DisableControls;
    try
      BMark := GetBookmark;
      First;
      while not Eof do
      begin
        Selected := Switch;
        Next;
      end;
      GotoBookmark(BMark);
    finally
      EnableControls;
      FreeBookmark(BMark);
    end;
  end;
  AllowRedraw := True;
end;

procedure Register;
begin
  RegisterComponents('Oasis', [TDBMultiGrid]);
end;


end.